home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / ints.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  1.4 KB  |  81 lines  |  [TEXT/MPS ]

  1. #include <stdio.h>
  2. #include "alloc.h"
  3. #include "fail.h"
  4. #include "memory.h"
  5. #include "mlvalues.h"
  6.  
  7. value int_of_string(s)          /* ML */
  8.      value s;
  9. {
  10.   long res;
  11.   int sign;
  12.   int base;
  13.   char * p;
  14.   int c, d;
  15.  
  16.   p = String_val(s);
  17.   sign = 1;
  18.   if (*p == '-') {
  19.     sign = -1;
  20.     p++;
  21.   }
  22.   base = 10;
  23.   if (*p == '0') {
  24.     switch (p[1]) {
  25.     case 'x': case 'X':
  26.       base = 16; p += 2; break;
  27.     case 'o': case 'O':
  28.       base = 8; p += 2; break;
  29.     case 'b': case 'B':
  30.       base = 2; p += 2; break;
  31.     }
  32.   }
  33.   res = 0;
  34.   while (1) {
  35.     c = *p;
  36.     if (c >= '0' && c <= '9')
  37.       d = c - '0';
  38.     else if (c >= 'A' && c <= 'F')
  39.       d = c - 'A' + 10;
  40.     else if (c >= 'a' && c <= 'f')
  41.       d = c - 'a' + 10;
  42.     else
  43.       break;
  44.     if (d >= base) break;
  45.     res = base * res + d;
  46.     p++;
  47.   }
  48.   if (*p != 0)
  49.     failwith("int_of_string");
  50.   return Val_long(sign < 0 ? -res : res);
  51. }
  52.  
  53. value format_int(fmt, arg)      /* ML */
  54.      value fmt, arg;
  55. {
  56.   char format_buffer[32];
  57.   int prec;
  58.   char * p;
  59.   char * dest;
  60.   value res;
  61.  
  62.   prec = 32;
  63.   for (p = String_val(fmt); *p != 0; p++) {
  64.     if (*p >= '0' && *p <= '9') {
  65.       prec = atoi(p) + 5;
  66.       break;
  67.     }
  68.   }
  69.   if (prec <= sizeof(format_buffer)) {
  70.     dest = format_buffer;
  71.   } else {
  72.     dest = stat_alloc(prec);
  73.   }
  74.   sprintf(dest, String_val(fmt), Long_val(arg));
  75.   res = copy_string(dest);
  76.   if (dest != format_buffer) {
  77.     stat_free(dest);
  78.   }
  79.   return res;
  80. }
  81.